home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-20
/
loadpole.zip
/
LOADPOLE.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-02-19
|
14KB
|
304 lines
10 'GW-BASIC LISTING FOR LOADPOLE (LOADED DIPOLE CALCULATIONS PROGRAM)
100 ' INITIALIZATION SUBROUTINE (LOADPOLE)
110 CLS:KEY OFF:SCREEN 9:COLOR 14,0
120 K=234:PI# = 3.141592654#
130 ' DICTIONARY OF VARIABLES AND TERMS
140 ' F = Frequency in megahertz (MHz)
150 ' A = Overall antenna length (feet)
160 ' B = Distance of each coil from center (feet)
170 ' D = Diameter of radiator conductor (inches)
180 ' End of dictionary
190 ' EXECUTION SUBROUTINE
200 GOSUB 440:' Get opening screen and music
210 GOSUB 2400:' Get dipole graphic screen for 5 seconds
220 GOSUB 550:' Get opening announcment
230 GOSUB 910:' Get main menu
240 ' Test value MENU and execute accordingly
250 ON MENU GOTO 260,360,100
260 GOSUB 650:' Get operating frequency (returns F)
270 GOSUB 780:' Get overall length of antenna in feet (returns A)
280 GOSUB 1720:' Go test A for correct value referenced to F
290 IF LL = 1 THEN CLS
300 IF LL = 1 THEN 230
310 GOSUB 1210:' Get position of loading coil (returns B)
320 GOSUB 1830:' Get antenna element conductor diameter (Return D)
330 GOSUB 2840:' Go do calculations
340 GOSUB 3010:' Go printout results
350 GOTO 230
360 ' END OF PROGRAM SUBROUTINE
370 CLS
380 LINE (320,180)-(220,140),3,BF
390 LINE (330,190)-(210,130),2,B
400 LOCATE 12,30:PRINT " GOODBYE "
410 TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+3:WEND
420 CLS:SCREEN 0
430 SYSTEM
440 ' OPENING SCREEN SUBROUTINE
450 NTE(1)=523.25:NTE(2)=493.88:NTE(3)=523.25:NTE(4)=587.33:NTE(5)=659.26
460 NTE(6)=698.46:NTE(7)=783.99:NTE(8)=880:NTE(9)=987.77:NTE(10)=1046.5
470 CLS:SCREEN 9:XXX1=400:XXX2=100:YYY1=50:YYY2=200:M=10:COLOR 15
480 LINE (XXX1,YYY1)-(XXX2,YYY2),,B:SOUND NTE(M),10
490 M=M-1:IF M = 0 THEN 510 ELSE 500
500 XXX1=XXX1+10:XXX2=XXX2+10:YYY1=YYY1+10:YYY2=YYY2+10:GOTO 480
510 COLOR 14:LOCATE 12,34:PRINT "LOADPOLE":COLOR 15
520 LOCATE 14,26:PRINT "Copyright 1991 J.J. Carr"
530 TIMELOOP=TIMER:WHILE TIMER < TIMELOOP + 2:WEND
540 RETURN:' End of subroutine
550 ' OPENING ANNOUNCEMENT
560 CLS:COLOR 14
570 LINE (555,240)-(134,125),3,BF:' Make colored text box
580 LOCATE 11,20:PRINT " "
590 LOCATE 12,20:PRINT " This program calculates the inductive reactance "
600 LOCATE 13,20:PRINT " and inductance required for loading coils in a "
610 LOCATE 14,20:PRINT " shortened dipole antenna. "
620 LOCATE 15,20:PRINT " "
630 LOCATE 16,30:GOSUB 2800
640 RETURN:' End of subroutine
650 ' PARAMETERS INPUT SUBROUTINE
660 CLS
670 LINE (580,195)-(125,140),3,BF
680 LOCATE 13,20:PRINT " and then press ENTER "
690 LOCATE 12,20:PRINT " Input the operating frequency in megahertz: ";
700 INPUT F$:' Get frequency in megahertz (alphanumeric)
710 ' Check for correct input
720 IF F$="" THEN BEEP
730 IF F$="" THEN 650
740 F = VAL(F$)
750 IF F = 0 THEN BEEP
760 IF F = 0 THEN 650
770 RETURN:' End of subroutine
780 ' OVERALL ANTENNA LENGTH SUBROUTINE
790 CLS
800 LINE (580,195)-(125,140),3,BF
810 LOCATE 13,20:PRINT " and then press ENTER "
820 LOCATE 12,20:PRINT " Input overall antenna length in feet ";
830 INPUT A$:' Get overall length in feet
840 ' Check for good input
850 IF A$="" THEN BEEP
860 IF A$="" THEN 780
870 A = VAL(A$)
880 IF A = 0 THEN BEEP
890 IF A = 0 THEN 780
900 RETURN:' End of subroutine
910 ' MAIN MENU SUBROUTINE
920 LL = 0
930 LINE (450,250)-(130,120),3,BF
940 LOCATE 11,25:PRINT " "
950 LOCATE 12,25:PRINT " (C)alculate values "
960 LOCATE 13,25:PRINT " (E)nd program "
970 LOCATE 14,25:PRINT " (R)estart entire program "
980 LOCATE 15,25:PRINT " "
990 LOCATE 17,25:PRINT " Please make selection: ";
1000 MENU$=INPUT$(1):' Get menu section
1010 ' Check for good input
1020 IF MENU$ = "" THEN BEEP
1030 IF MENU$ = "" THEN 910
1040 MENUCHEK = VAL(MENU$)
1050 IF MENUCHEK > 0 THEN BEEP
1060 IF MENUCHEK > 0 THEN 910
1070 IF MENU$ = "0" THEN BEEP
1080 IF MENU$ = "0" THEN 910
1090 ' Convert MENU$ to MENU number
1100 IF MENU$="C" THEN MENU = 1
1110 IF MENU$="c" THEN MENU = 1
1120 IF MENU$="E" THEN MENU = 2
1130 IF MENU$="e" THEN MENU = 2
1140 IF MENU$="R" THEN MENU = 3
1150 IF MENU$="r" THEN MENU = 3
1160 IF MENU > 3 THEN BEEP
1170 IF MENU > 3 THEN 910
1180 IF MENU < 1 THEN BEEP
1190 IF MENU < 1 THEN 910
1200 RETURN:' End of subroutine
1210 ' SUBROUTINE TO DETERMINE COIL LOCATION
1220 CLS
1230 LINE (550,280)-(120,130),3,BF
1240 LOCATE 11,20:PRINT " "
1250 LOCATE 12,20:PRINT " Please select location of coil "
1260 LOCATE 13,20:PRINT " "
1270 LOCATE 14,20:PRINT " (C)enter of each element (50-percent) "
1280 LOCATE 15,20:PRINT " (O)ne-third way on each element (33-percent) "
1290 LOCATE 16,20:PRINT " (F)eedpoint of antenna (0-percent) "
1300 LOCATE 17,20:PRINT " (S)elect different location "
1310 LOCATE 18,20:PRINT " "
1320 LOCATE 19,20:PRINT " Make selection please... ";
1330 B$ = INPUT$(1)
1340 ' Check for good input
1350 IF B$ = "" THEN BEEP
1360 IF B$ = "" THEN 1210
1370 BCHEK=VAL(B$)
1380 IF BCHEK > 0 THEN BEEP
1390 IF BCHEK > 0 THEN 1210
1400 IF B$="0" THEN BEEP
1410 IF B$="0" THEN 1210
1420 ' Convert B$ to B numeric
1430 IF B$ = "C" THEN B = .5*(A/2)
1440 IF B$ = "c" THEN B = .5*(A/2)
1450 IF B$ = "O" THEN B = .333*(A/2)
1460 IF B$ = "o" THEN B = .333*(A/2)
1470 IF B$ = "F" THEN B = .0001*(A/2)
1480 IF B$ = "f" THEN B = .0001*(A/2)
1490 IF B$ = "S" THEN B = 1
1500 IF B$ = "s" THEN B = 1
1510 ' Test value of B numeric
1520 IF B = 0 THEN BEEP
1530 IF B = 0 THEN 1210
1540 ' Decide what to do based on value of B
1550 IF B = 1 THEN 1570 ELSE 1710
1560 ' Select own percentage for loading coil
1570 CLS:LINE (550,240)-(120,130),3,BF
1580 LOCATE 11,20:PRINT " "
1590 LOCATE 12,20:PRINT " Enter location of loading coil in feet "
1600 LOCATE 13,20:PRINT " from center feed point of antenna. Must "
1610 LOCATE 14,20:PRINT " be less than overall length entered before. "
1620 LOCATE 15,20:PRINT " "
1630 LOCATE 16,20:PRINT " Input value and press ENTER ";
1640 INPUT B$
1650 B = VAL(B$)
1660 ' Check for good input
1670 IF B = 0 THEN BEEP
1680 IF B = 0 THEN 1570
1690 IF B > A THEN BEEP
1700 IF B > A THEN 1570
1710 RETURN:' End of subroutine
1720 ' SUBROUTINE TO TEST FOR VALUE OF "A" RELATIVE TO "F"
1730 L = 468/F:' Calculate regular length of fullsize dipole
1740 IF A > L THEN 1750 ELSE 1820:'Compare to full size dipole
1750 BEEP:CLS:LINE (550,220)-(130,130),3,BF:' Message for L>A error
1760 LOCATE 11,20:PRINT " "
1770 LOCATE 12,20:PRINT " Shortened dipole not needed because selected "
1780 LOCATE 13,20:PRINT " length is longer than half-wavelength at the "
1790 LOCATE 14,20:PRINT " selected frequency. "
1800 LOCATE 15,20:PRINT " "
1810 LL=1:TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+3:WEND
1820 RETURN:' End of subroutine
1830 ' SUBROUTINE TO DETERMINE ANTENNA CONDUCTOR SIZE
1840 CLS:' Draw screen
1850 LINE (520,340)-(125,80),3,BF
1860 LOCATE 8,20:PRINT " "
1870 LOCATE 10,20:PRINT " "
1880 LOCATE 9,20:PRINT " Select antenna element conductor size "
1890 LOCATE 11,20:PRINT " 1. #10 wire "
1900 LOCATE 12,20:PRINT " 2. #12 wire "
1910 LOCATE 13,20:PRINT " 3. #14 wire "
1920 LOCATE 14,20:PRINT " 4. #16 wire "
1930 LOCATE 15,20:PRINT " 5. #18 wire (not recommended) "
1940 LOCATE 16,20:PRINT " 6. #20 wire (not recommended) "
1950 LOCATE 17,20:PRINT " 7. #22 wire (not recommended) "
1960 LOCATE 18,20:PRINT " 8. Aluminum or copper tubing "
1970 LOCATE 19,20:PRINT " "
1980 LOCATE 21,20:PRINT " Make selection... ";
1990 D$ = INPUT$(1)
2000 'Check for good input
2010 D = VAL(D$)
2020 IF D < 1 THEN BEEP
2030 IF D < 1 THEN 1830
2040 IF D > 8 THEN BEEP
2050 IF D > 8 THEN 1830
2060 IF D = 1 THEN DD$ = " #10 wire "
2070 IF D = 2 THEN DD$ = " #12 wire "
2080 IF D = 3 THEN DD$ = " #14 wire "
2090 IF D = 4 THEN DD$ = " #16 wire "
2100 IF D = 5 THEN DD$ = " #18 wire "
2110 IF D = 6 THEN DD$ = " #20 wire "
2120 IF D = 7 THEN DD$ = " #22 wire "
2130 ' Select aluminum/copper tubing size
2140 IF D = 8 THEN 2270 ELSE 2160
2150 IF D = 8 THEN DD$ = "Alum/Copper Tubing "
2160 LOCATE 22,20:PRINT DD$
2170 TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+.5:WEND:CLS
2180 IF D = 1 THEN D = .1019
2190 IF D = 2 THEN D = .0808
2200 IF D = 3 THEN D = .0641
2210 IF D = 4 THEN D = .0508
2220 IF D = 5 THEN D = .0403
2230 IF D = 6 THEN D = .032
2240 IF D = 7 THEN D = .0253
2250 IF D = 8 THEN D = D
2260 GOTO 2380:' Go to end of routine
2270 ' Subroutine to select tubing diameter
2280 CLS:LINE (500,200)-(120,120),3,BF:' Draw screen
2290 LOCATE 12,20:PRINT " "
2300 LOCATE 13,20:PRINT " Select tubing outside diameter (o.d.) "
2310 LOCATE 14,20:PRINT " 0.5 inch to 2 inch ";
2320 INPUT D:'Enter tubing size
2330 IF D < .5 THEN BEEP
2340 IF D < .5 THEN 2270
2350 IF D > 2 THEN BEEP
2360 IF D > 2 THEN 2270
2370 GOTO 2150
2380 RETURN:' End of subroutine
2390 LINE (52,105)-(58,110)
2400 'SUBROUTINE FOR GRAPHIC OPENING
2410 CLS
2420 LINE (600,150)-(50,150)
2430 LINE (600,149)-(50,149)
2440 LINE (335,150)-(315,150),0,BF
2450 LINE (335,149)-(315,149),0,BF
2460 LINE (335,225)-(335,150)
2470 LINE (315,225)-(315,150)
2480 LINE (198,155)-(178,145),3,BF
2490 LINE (473,155)-(453,145),3,BF
2500 LINE (600,142)-(600,90)
2510 LINE (50,142)-(50,90)
2520 LINE (52,105)-(598,105)
2530 LINE (340,105)-(310,105),0,BF
2540 LOCATE 8,41:PRINT "A"
2550 LINE (52,105)-(58,100)
2560 LINE (52,105)-(58,110)
2570 LINE (598,105)-(592,100)
2580 LINE (598,105)-(592,110)
2590 LINE (449,130)-(202,130)
2600 LINE (449,145)-(449,125)
2610 LINE (201,145)-(201,125)
2620 LINE (337,135)-(313,125),0,BF
2630 LOCATE 10,32:PRINT " B "
2640 LOCATE 10,48:PRINT " B "
2650 LINE (335,143)-(335,125)
2660 LINE (315,143)-(315,125)
2670 LINE (315,130)-(310,125)
2680 LINE (315,130)-(310,135)
2690 LINE (202,130)-(207,125)
2700 LINE (202,130)-(207,135)
2710 LINE (449,130)-(444,125)
2720 LINE (449,130)-(444,135)
2730 LINE (335,130)-(340,125)
2740 LINE (335,130)-(340,135)
2750 LOCATE 13,24:PRINT "L1"
2760 LOCATE 13,58:PRINT "L2"
2770 LOCATE 18,18:PRINT " Form of the inductor loaded shortened dipole "
2780 TIMELOOP=TIMER:WHILE TIMER<TIMELOOP+5:WEND
2790 CLS:RETURN:' End of subroutine
2800 ' SUBROUTINE: Press Any Key
2810 PRINT " Press any key to continue "
2820 AA$=INKEY$:IF AA$="" THEN 2820
2830 RETURN:' End of subroutine
2840 'CALCULATIONS SUBROUTINE
2850 CLS:LINE (500,150)-(130,120),3,BF:' Draw screen
2860 LOCATE 10,30:PRINT " Doing Arithmetic "
2870 LOCATE 12,30:PRINT " "
2880 'Arithmetic
2890 MA# = (10^6)/(34*PI#*F)
2900 MB# = (LOG(((24*(K/F))-B)/(D)) - 1)
2910 MC# = (K/F) - B
2920 MD# = (((1 - ((F*B)/(K)) )^2) - 1)
2930 ME# = (MB#*MD#)/MC#
2940 MF# = (LOG((1/D)*24*((A/2)-B))) - 1
2950 MG# = ((((F*A)/2)-(F*B))/K)^2 - 1
2960 MH# = ((A/2) - B)
2970 MI# = (MF#*MG#)/MH#
2980 XL# = MA#*(ME# - MI#)
2990 LUH# = XL#/(2*PI#*F)
3000 RETURN:' End of subroutine
3010 ' RESULTS PRINTOUT SUBROUTINE
3020 CLS:LINE (550,255)-(120,130),3,BF
3030 LOCATE 12,20:PRINT " Operating frequency: ";F;" MHz "
3040 LOCATE 13,20:PRINT " Overall length of antenna: ";A;" Feet "
3050 LOCATE 14,20:PRINT " Distance from center to each coil: ";B;" Feet "
3060 LOCATE 15,20:PRINT " Inductive reactance of coil : ";
3070 PRINT USING "#####.#";XL#;:PRINT " Ohms "
3080 LOCATE 16,20:PRINT " Inductance of coil: ";
3090 PRINT USING "####.##";LUH#;:PRINT " uH "
3100 LOCATE 18,20:GOSUB 2800
3110 CLS:RETURN:' End of subroutine